home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
backup.arc
/
BACKUP.CLP
next >
Wrap
Text File
|
1991-12-04
|
36KB
|
445 lines
/*~ CRTCLPGM PGM(BACKUP.YOURLIB) SRCFILE(YOUSRC.YOURLIB) +
~ USRPRF(*OWNER) PUBAUT(*NORMAL) ~*/
/*~*******************************************************~*/
/*~PROGRAM: BACKUP.YOURLIB ~*/
/*~DISCRIPTION: PROCESS BACKUP COMMANDS ~*/
/*~ ~*/
/*~COMPILATION OPTIONS: NONE ~*/
/*~SWITCHES: NONE ~*/
/*~ ~*/
/*~WRITEN BY BRIAN GREWAL. ~*/
/*~ ~*/
/*~I TAKE NO RESPONSIBILITY OF FUNCTION OF THIS CODE. ~*/
/*~COMPILE AND EXECUTE IT AT YOUR OWN RISK. ~*/
/*~ ~*/
/*~ ~*/
/*~ ~*/
/*~*******************************************************~*/
PGM PARM(&BKPTYP &DEVICE &OBJ &LIB &SAVCOD &RTNCOD)
DCL &BKPTYP *CHAR 7
DCL &DEVICE *CHAR 1
DCL &OBJ *CHAR 550
DCL &LIB *CHAR 550
DCL &SAVCOD *CHAR 1
DCL VAR(&RTNCOD) TYPE(*CHAR) LEN(8)
DCL &SAVF *CHAR 10
DCL &WLIB *CHAR 10
DCL &TEXT *CHAR 50
DCL &QDATE *CHAR 6
DCL VAR(&C1) TYPE(*DEC) LEN(3 0)
DCL VAR(&C2) TYPE(*DEC) LEN(3 0) VALUE(1)
DCL &WOBJS *CHAR 550
DCL &WLIBS *CHAR 550
DCL &CMD *CHAR 2000
DCL &RTNPOINT *CHAR 7
DCL &TYPE *CHAR 1
DCL &MSGID *CHAR 7
DCL &MSG *CHAR 200
DCL &MSGDTA *CHAR 100
DCL &MSGF *CHAR 10
DCL &MSGFLIB *CHAR 10
DCL VAR(&ATTR) TYPE(*CHAR) LEN(1) VALUE(X'2B')
DCL VAR(&NORMAL) TYPE(*CHAR) VALUE(X'20')
DCL VAR(&RI) TYPE(*CHAR) LEN(1) VALUE(X'21')
/*~ MONITOR FOR MESSAGES~*/
MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
RTVSYSVAL SYSVAL(QDATE) RTNVAR(&QDATE)
RTVJOBA TYPE(&TYPE)
/*~TRUNCATE EXTRA SPACES FROM OBJECT AND LIBRARY NAMES ~*/
IF (&SAVCOD *EQ 'A') DO
TCATA: IF (&C1 *LE 49) THEN(DO)
CHGVAR &C1 (&C1+1)
IF COND(&C1 = 1) THEN(CHGVAR VAR(&WLIBS) +
VALUE(%SST(&LIB 1 10)))
ELSE CMD(CHGVAR VAR(&WLIBS) VALUE(&WLIBS *BCAT +
%SST(&LIB &C2 10)))
CHGVAR &C2 (&C2+11)
GOTO TCATA
ENDDO /*~ &C1 *LE 49~*/
ENDDO /*~ &SAVCOD *EQ 'A' ~*/
CHGVAR &C1 (&C1 * 0)
CHGVAR &C2 ((&C2 * 0) + 1)
IF (&SAVCOD *EQ 'S') DO
TCATS: IF (&C1 *LE 49) THEN(DO)
CHGVAR &C1 (&C1+1)
IF COND(&C1 = 1) THEN(CHGVAR VAR(&WOBJS) +
VALUE(%SST(&OBJ 1 10)))
ELSE CMD(CHGVAR VAR(&WOBJS) VALUE(&WOBJS *BCAT +
%SST(&OBJ &C2 10)))
CHGVAR &C2 (&C2+11)
GOTO TCATS
ENDDO /*~ &C1 *LE 49~*/
ENDDO /*~ &SAVCOD *EQ 'S' ~*/
CHGVAR &C1 (&C1 * 0)
CHGVAR &C2 ((&C2 * 0) + 1)
/*~- - - - - - D A I L Y B A C K U P - - - - ~*/
/*~ PROCESS IF DAILY BACKUP REQUESTED~*/
IF COND(&BKPTYP *EQ 'DAILY ') THEN(DO) /*~Daily +
~ +
~ backup~*/
DAILY: CHGVAR &RTNPOINT 'DAILY '
IF COND(&SAVCOD *EQ 'A') THEN(DO) /*~Objects +
~ *all~*/
/*~SAVE TO SAVE FILE~*/
IF COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/
DALOOP: IF (&C1 *LE 49) THEN(DO)
CHGVAR &C1 (&C1+1)
CHGVAR &WLIB %SST(&LIB &C2 10)
IF (&WLIB *NE ' ') THEN(DO)
CHGVAR &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +
%SST(&WLIB 7 4))
CHGVAR VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +
'save file for' *BCAT &WLIB *BCAT 'created' +
*BCAT &QDATE)
CHKOBJ OBJ(&SAVF.QGPL) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))
CHGSAVF FILE(&SAVF.QGPL) TEXT(&TEXT)
CLRSAVF FILE(&SAVF.QGPL)
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT 'ALL' *TCAT '.' *TCAT &WLIB *TCAT +
&NORMAL *TCAT 'to savefile' *BCAT &SAVF +
*BCAT 'in process') TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
SAVCHGOBJ OBJ(*ALL) LIB(&WLIB) SAVF(&SAVF.QGPL) +
DTACPR(*YES)
ENDDO /*~ &WLIB *NE *BLANKS ~*/
CHGVAR VAR(&C2) VALUE(&C2 +11)
GOTO DALOOP
ENDDO /*~IF &C1 LE 49~*/
ENDDO /*~ IF &DEVICE *EQ 'S' ~*/
/*~SAVE TO DISKETTE ~*/
IF COND(&DEVICE *EQ 'D') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVCHGOBJ OBJ(*ALL) LIB(' +
*TCAT &WLIBS *TCAT ') LOC(*M12 *SEARCH) +
DTACPR(*YES) CLEAR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT '*ALL' *TCAT '.' *TCAT &WLIBS *TCAT +
&NORMAL *BCAT 'to Diskette in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ DEVICE *EQ 'D' ~*/
/*~SAVE TO TAPE ~*/
IF COND(&DEVICE *EQ 'T') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVCHGOBJ OBJ(*ALL) LIB(' +
*TCAT &WLIBS *TCAT ') DEV(QTAPE1) +
ENDOPT(*LEAVE)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(CPF9898.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT '*ALL' *TCAT '.' *TCAT &WLIBS *TCAT +
&NORMAL *BCAT 'to Tape in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ DEVICE *EQ 'T' ~*/
ENDDO /*~&SAVCOD IFEQ 'A'~*/
ELSE DO /*~SAVE CODE EQ 'S'~*/
/*~SAVE TO SAVE FILE~*/
CHGVAR &WLIB %SST(&LIB 1 10)
IF COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/
CHGVAR &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +
%SST(&WLIB 7 4))
CHGVAR VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +
'save file for' *BCAT &WLIB *BCAT 'created' +
*BCAT &QDATE)
CHKOBJ OBJ(&SAVF.QGPL) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))
CHGSAVF FILE(&SAVF.QGPL) TEXT(&TEXT)
CLRSAVF FILE(&SAVF.QGPL)
CHGVAR VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +
*TCAT ') LIB(' *TCAT &WLIB *TCAT ') SAVF(' +
*TCAT &SAVF *TCAT '.QGPL) DTACPR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(CPF9898.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of selected +
objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +
&NORMAL *BCAT 'to savefile' *BCAT &SAVF +
*BCAT 'in process') TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'S' ~*/
/*~SAVE TO DISKETTE ~*/
IF COND(&DEVICE *EQ 'D') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +
*TCAT ') LIB(' *TCAT &WLIB *TCAT ') +
LOC(*M12 *SEARCH) DTACPR(*YES) CLEAR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of selected +
objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +
&NORMAL *BCAT 'to Diskette in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'D' ~*/
/*~SAVE TO TAPE ~*/
IF COND(&DEVICE *EQ 'T') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +
*TCAT ') LIB(' *TCAT &WLIB *TCAT ') +
DEV(QTAPE1) ENDOPT(*LEAVE)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of selected +
objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +
&NORMAL *BCAT 'to Tape in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'T' ~*/
ENDDO /*~SAVCOD *EQ 'S'~*/
ENDDO /*~ &BKPTYP *EQ 'DAILY'~*/
/*~- - - - - - - W E E K L Y B A C K U P - - - - ~*/
/*~- - - - - - - - - - - - O R - - - - - - - - - ~*/
/*~- - - - - S P E C I A L B A C K U P - - - ~*/
/*~ PROCESS IF SPECIAL OR WEEKLY REQUESTED~*/
IF COND((&BKPTYP *EQ 'WEEKLY ') *OR (&BKPTYP *EQ +
'SPECIAL')) THEN(DO) +
/*~~ Weekly backup~*/
WEEKLY: CHGVAR &RTNPOINT 'WEEKLY '
IF COND(&SAVCOD *EQ 'A') THEN(DO) /*~Objects +
~ *all~*/
/*~SAVE TO SAVE FILE~*/
IF COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/
WALOOP: IF (&C1 *LE 49) THEN(DO)
CHGVAR &C1 (&C1+1)
CHGVAR &WLIB %SST(&LIB &C2 10)
IF (&WLIB *NE ' ') THEN(DO)
CHGVAR &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +
%SST(&WLIB 7 4))
CHGVAR VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +
'save file for' *BCAT &WLIB *BCAT 'created' +
*BCAT &QDATE)
CHKOBJ OBJ(&SAVF.QGPL) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))
CHGSAVF FILE(&SAVF.QGPL) TEXT(&TEXT)
CLRSAVF FILE(&SAVF.QGPL)
CHGVAR VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIB +
*TCAT ') SAVF(' *TCAT &SAVF *TCAT '.QGPL) +
DTACPR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT &WLIB *TCAT &NORMAL *TCAT 'to +
savefile' *TCAT &ATTR *TCAT &SAVF *TCAT +
&NORMAL *TCAT 'in process') TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ &WLIB *NE *BLANKS ~*/
CHGVAR &C2 (&C2+11)
GOTO WALOOP
ENDDO /*~IF &C1 LE 49~*/
ENDDO /*~ IF &DEVICE *EQ 'S' ~*/
/*~SAVE TO DISKETTE ~*/
IF COND(&DEVICE *EQ 'D') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +
*TCAT ') LOC(*M12 *SEARCH) DTACPR(*YES) +
CLEAR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT &WLIBS *TCAT &NORMAL *TCAT 'to +
Diskette in process') TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'D' ~*/
/*~SAVE TO TAPE ~*/
IF COND(&DEVICE *EQ 'T') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +
*TCAT ') DEV(QTAPE1) ENDOPT(*LEAVE)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT &WLIBS *TCAT &NORMAL *TCAT 'to Tape +
in process') TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'T' ~*/
ENDDO /*~&SAVCOD IFEQ 'A'~*/
ELSE DO /*~SAVE CODE EQ 'S'~*/
/*~SAVE TO SAVE FILE~*/
CHGVAR &WLIB %SST(&LIB 1 10)
IF COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/
CHGVAR &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +
%SST(&WLIB 7 4))
CHGVAR VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +
'save file for' *BCAT &WLIB *BCAT 'created' +
*BCAT &QDATE)
CHKOBJ OBJ(&SAVF.QGPL) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))
CHGSAVF FILE(&SAVF.QGPL) TEXT(&TEXT)
CLRSAVF FILE(&SAVF.QGPL)
CHGVAR VAR(&CMD) VALUE('SAVOBJ OBJ(' *TCAT &WOBJS +
*TCAT ') LIB(' *TCAT &WLIB *TCAT ') +
SAVF(&SAVF.QGPL) DTACPR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of selected +
objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +
&NORMAL *BCAT 'to savefile' *BCAT &SAVF +
*BCAT 'in process') TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'S' ~*/
/*~SAVE TO DISKETTE ~*/
IF COND(&DEVICE *EQ 'D') THEN(DO)
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of selected +
objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +
&NORMAL *BCAT 'to Diskette in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
SAVOBJ OBJ(&WOBJS) LIB(&WLIB) LOC(*M12 *SEARCH) +
DTACPR(*YES)
ENDDO /*~Device *eq 'D'~*/
/*~SAVE TO TAPE ~*/
IF COND(&DEVICE *EQ 'T') THEN(DO)
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of selected +
objects from' *TCAT &ATTR *TCAT &WLIB *TCAT +
&NORMAL *BCAT 'to Tape in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
SAVOBJ OBJ(&WOBJS) LIB(&WLIB) DEV(QTAPE1) +
ENDOPT(*LEAVE)
ENDDO /*~DEVICE *EQ 'T'~*/
ENDDO /*~SAVCOD *EQ 'S'~*/
ENDDO /*~ &BKPTYP *EQ 'WEEKLY'~*/
/*~- - - - - - - M O N T H L Y B A C K U P - - - - ~*/
/*~ PROCESS IF DAILY MONTHLY REQUESTED~*/
IF COND(&BKPTYP *EQ 'MONTHLY ') THEN(DO) /*~+
~ Weekly backup~*/
MONTHLY: CHGVAR &RTNPOINT 'MONTHLY'
IF COND(&SAVCOD *EQ 'A') THEN(DO) /*~Objects +
~ *all~*/
/*~SAVE TO SAVE FILE~*/
IF COND(&DEVICE *EQ 'S') THEN(DO) /*~save file~*/
MALOOP: IF (&C1 *LE 9) THEN(DO)
CHGVAR &C1 (&C1+1)
CHGVAR &WLIB %SST(&LIB &C2 10)
IF (&WLIB *NE ' ') THEN(DO)
CHGVAR &SAVF ('SA' *TCAT %SST(&WLIB 1 4) *TCAT +
%SST(&WLIB 7 4))
CHGVAR VAR(&TEXT) VALUE(&RI *TCAT &BKPTYP *BCAT +
'save file for' *BCAT &WLIB *BCAT 'created' +
*BCAT &QDATE)
CHKOBJ OBJ(&SAVF.QGPL) OBJTYPE(*FILE)
MONMSG MSGID(CPF9801) EXEC(CRTSAVF FILE(&SAVF))
CHGSAVF FILE(&SAVF.QGPL) TEXT(&TEXT)
CLRSAVF FILE(&SAVF.QGPL)
CHGVAR VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIB +
*TCAT ') SAVF(' *TCAT &SAVF *TCAT '.QGPL) +
DTACPR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT &WLIB *TCAT &NORMAL *TCAT 'to +
savefile' *BCAT &SAVF *BCAT 'in process') +
TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ &WLIB *NE *BLANKS ~*/
CHGVAR &C2 (&C2+11)
GOTO MALOOP
ENDDO /*~IF &C1 LE 9~*/
ENDDO /*~ IF &DEVICE *EQ 'S' ~*/
/*~SAVE TO DISKETTE ~*/
IF COND(&DEVICE *EQ 'D') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +
*TCAT ') LOC(*M12 *SEARCH) DTACPR(*YES) +
CLEAR(*YES)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT &WLIBS *TCAT &NORMAL *TCAT 'to +
Diskette in process') TOPGMQ(*EXT) +
MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'D' ~*/
/*~SAVE TO TAPE ~*/
IF COND(&DEVICE *EQ 'T') THEN(DO)
CHGVAR VAR(&CMD) VALUE('SAVLIB LIB(' *TCAT &WLIBS +
*TCAT ') DEV(QTAPE1) ENDOPT(*LEAVE)')
IF COND(&TYPE = '1') THEN(SNDPGMMSG +
MSGID(CPF9898) MSGF(QCPFMSG.QSYS) +
MSGDTA(&BKPTYP *BCAT 'save of' *TCAT &ATTR +
*TCAT &WLIBS *TCAT &NORMAL *TCAT 'to Tape +
in process') TOPGMQ(*EXT) MSGTYPE(*STATUS))
CALL PGM(QCAEXEC) PARM(&CMD 2000)
ENDDO /*~ IF &DEVICE *EQ 'T' ~*/
ENDDO /*~&SAVCOD IFEQ 'A'~*/
ENDDO /*~ &BKPTYP *EQ 'MONTHLY'~*/
RETURN
ERROR: /*~STANDARD ERROR HANDLING ROUTINE~*/
RCVMSG MSGTYPE(*EXCP) MSG(&MSG) MSGDTA(&MSGDTA) +
MSGID(&MSGID) MSGF(&MSGF) MSGFLIB(&MSGFLIB)
IF COND(&MSGID *EQ 'CPF3793') THEN(DO)
CHGVAR VAR(&RTNCOD) VALUE('ABORT ')
SNDPGMMSG MSGID(&MSGID) MSGF(&MSGF.&MSGFLIB) +
MSGDTA(&MSGDTA) TOMSGQ(QSYSOPR) +
MSGTYPE(*ESCAPE)
ENDDO
ELSE DO
CHGVAR &C2 (&C2+11)
SNDMSG MSG(&MSG) TOMSGQ(QSYSOPR) MSGTYPE(*INFO)
IF (&RTNPOINT *EQ 'DAILY ') GOTO DAILY
IF (&RTNPOINT *EQ 'WEEKLY ') GOTO WEEKLY
IF (&RTNPOINT *EQ 'MONTHLY') GOTO MONTHLY
ENDDO
ENDPGM